#!/usr/bin/perl
# $Id: Hypersrc.pl,v 1.163 2005/02/04 00:56:20 jimb Exp $
# Author   : Jim Brooks http://www.jimbrooks.org
# Synopsis : Perl script to automate running hypersrc.
# Usage    : See "Hypersrc.pl -help" and "hypersrc -help" for option list.
# Overview : 1. "find" is called to build a list of src files
#               (unless -srcs/-dirs is passed/implied).
#            2. ctags.pl (which wraps/augments Exuberant ctags) is called
#               to produce lines of tags.
#            3. The tags lines are piped to "hypersrc".
# Notes    : This script is sed-edited by "make install".
# -----------------------------------------------------------------------------

use English;
use Cwd;
use File::Basename;

# =============================================================================
# ==== BEGIN ESSENTIAL CONFIGURATION ==========================================

# Paths to hypersrc and the programs it depends on.
# (Don't write ~ - Perl won't expand it.)
#
$hypersrc = "hypersrc";
$ctags_pl = "ctags.pl";
$ctags    = "ctags";
$gfind    = "find";		# preferably, path to GNU find

# ==== END ESSENTIAL CONFIGURATION ============================================
# =============================================================================

# =============================================================================
# ==== BEGIN NON-ESSENTIAL CONFIGURATION ======================================

# $argsHypersrcCustom is intended to hold custom hypersrc-only args.
#
$argsHypersrcCustom = "";

# For lo-res screen:
#$argsHypersrcCustom = "-tab-width 4  -geom 80 160 940 600 -TagModuleTypeLine -column-widths 140 90 70 20  -max-tags 100000 -font-list \"6x12\"";
#
# For med-res screen:
#$argsHypersrcCustom = "-tab-width 4  -geom 24 80 1000 680 -TagModuleTypeLine -column-widths 110 70 46 20  -max-tags 100000 -font-list \"6x12\"";
#
# For hi-res screen:
#$argsHypersrcCustom = "-tab-width 4  -geom 24 100 1200 720 -TagModuleTypeLine -column-widths 140 90 56 30  -max-tags 100000 -font-list \"6x12\"";

# Default amount of subdir levels to descend (1 means one subdir level).
#
$descend = 5;

# Verbosity.
#
$verbose = 1;

# Set a short or long window title (either based on CWD).
#
$shortWindowTitleFlag = 1;

# For per-user customization, include an optional inline Perl file.
# The inline file could override any previous state.
# Example of storing args into ~/.hypersrcpl:
# @argsCustom = ( "-descend", "10" );
#
@argsCustom = ( ); # optionally can be assigned by user's ~/.hypersrcpl
if ( -f $ENV{"HOME"} . "/.hypersrcpl" ) { eval `cat ~/.hypersrcpl 2>/dev/null`; }

# ==== END NON-ESSENTIAL CONFIGURATION ========================================
# =============================================================================

# Variables.
#
$Hypersrc_pl          = basename( $PROGRAM_NAME );
@argsHypersrc         = ( );
$ignoreNextArg        = 0;
$ctagsArgPassed       = 0;
$ctags_pl_args        = "";
$srcsOption           = 0;		# true if "-srcs" was passed (or implied)
$srcString            = "";		# string of lines of total filenames
$ignoreCase           = 0;
$gdb				  = 0;
$valgrind             = 0;
$stayQuiet            = 0;      # if true, any subsequent -v (verbose) is ignored
$title                = "";
$titleLenMax		  = 80;		# max len of chars in title string
@ext                  = ( );
@srcs                 = ( );	# list of src files passed by cmd-line
@dirs                 = ( );	# list of dirs passed with "-dirs"
@excludeList          = ( );	# list of patterns to exclude pathnames
@includeList          = ( );	# list of patterns to include pathnames

print "\n"; # so that "Hypersrc.pl&" won't print on shell prompt line

# TMPDIR must be defined or ctags might print this error:
# "ctags: cannot open temporary file : No such file or directory"
if (   ! defined( $ENV{"TMPDIR"} )
    || ! -d $ENV{"TMPDIR"} )
{
   if (    defined( $ENV{"TMP"} )
        && -d $ENV{"TMP"} )
   {
      $ENV{"TMPDIR"} = $ENV{"TMP"};
   }
   elsif ( -d $ENV{"HOME"}."/tmp" )
   {
      $ENV{"TMPDIR"} = $ENV{"HOME"}."/tmp";
   }
   elsif ( -d "/tmp" )
   {
      $ENV{"TMPDIR"} = "/tmp";
      print STDERR "WARNING: Assigning environment variable TMPDIR=/tmp (needed by ctags). \n";
      print STDERR "WARNING: You should assign TMPDIR to a subdir in your HOME. \n";
   }
   else
   {
      ErrorMsg( "## The environment variable TMPDIR is needed by ctags. \n" );
      ErrorMsg( "## You should assign TMPDIR to a subdir in your HOME. \n" );
      exit 1;
   }
}

# --------------------------- Arg pass 1 of 3 ----------------------------------

# Parse args passed to Hypersrc.pl (some may be intended for hypersrc).
# Filter-out args that only Hypersrc.pl understands
# by building a second arg list that Hypersrc.pl doesn't understand,
# which is assumed to be args for hypersrc.
# Some args (eg -q) must processed very early.
# Such args will be encountered more than once!

@args1 = ( ); # will hold complement of args processed in this pass
foreach ( (@ARGV,@argsCustom) )
{
   if ( $_ eq "-q"  ||  $_ eq "--quiet" )
   {
      $stayQuiet = 1; # user passed -q so ignore any -v in ~/.hypersrcpl
      $verbose = 0;
      @argsHypersrc = ( @argsHypersrc, "-q" );
      next;
   }

   if ( $_ eq "-v"  ||  $_ eq "--verbose" )
   {
      if ( $stayQuiet ) { next; }

      $verbose = 1;
      @argsHypersrc = ( @argsHypersrc, "-v" );
      next;
   }

   @args1 = ( @args1, $_ );
}

# --------------------------- Arg pass 2 of 3 ----------------------------------

@args2 = ( ); # will hold complement of args processed in this pass
foreach ( @args1 )
{
   # -case ?
   #
   if ( $_ eq "-case" )
   {
      $ignoreCase = 0;
      next;
   }

   # -no-case ?
   #
   if ( $_ eq "-no-case"  ||  $_ eq "-nocase"  ||  $_ eq "-nc" )
   {
      $ignoreCase = 1;

      # If this is a FreeBSD system, for -no-case to work,
      # choose GNU find ("gfind") over BSD find.
      # (GNU find is part of the findutils package.)
      #
      $uname = `uname`;
      if ( $uname =~ "FreeBSD" )
      {
         $gfind = `which gfind`;
         chomp $gfind;  # sometimes `which` spews a newline
         if ( "$gfind" eq "" )
         {
            ErrorMsg( "## This is a FreeBSD system without gfind. \n" );
            ErrorMsg( "## -no-case will only work if the GNU findutils pkg is installed. \n" );
            exit 1;
         }
      }
      Msg( "Will ignore filename case. \n" );
      next;
   }

   @args2 = ( @args2, $_ );
}

# --------------------------- Arg pass 3 of 3 ----------------------------------

@args = @args2;
$argIdxPrevImplSrc = -999; # idx of previous implied src file
for ( $argIdx = 0; $argIdx <= $#args; $argIdx++ )
{
   $_ = $args[$argIdx];

   # Should this arg be ignored?
   #
   if ( $ignoreNextArg )
   {
      $ignoreNextArg = 0;
      next;
   }

   if (    $_ eq "--help"  ||  $args[$#args] eq "--help"
        || $_ eq "-help"   ||  $args[$#args] eq "-help"
        || $_ eq "-h"      ||  $args[$#args] eq "-h" )
   {
      print( "Usage:                                                                \n" );
      print( "                                                                      \n" );
      print( "   Hypersrc.pl <options> [file(s)] [dir(s)]                           \n" );
      print( "                                                                      \n" );
      print( "   (See also hypersrc -h)                                             \n" );
      print( "                                                                      \n" );
      print( "Synopsis:                                                             \n" );
      print( "                                                                      \n" );
      print( "   Hypersrc.pl is a front-end script to run hypersrc.                 \n" );
      print( "                                                                      \n" );
      print( "Default options:                                                      \n" );
      print( "                                                                      \n" );
      print( "   If no options are passed, then Hypersrc.pl will                    \n" );
      print( "   default to browsing C src files from the CWD                       \n" );
      print( "   and will descend down to $descend subdir levels.                   \n" );
      print( "                                                                      \n" );
      print( "File/dir args:                                                        \n" );
      print( "                                                                      \n" );
      print( "   Pass the name(s) of src file(s) that Exuberant ctags supports.     \n" );
      print( "                                                                      \n" );
      print( "   If the name(s) of a dir(s) is passed, then this script will        \n" );
      print( "   search for src files of the specified programming language(s)      \n" );
      print( "   (default is C).                                                    \n" );
      print( "                                                                      \n" );
      print( "Options affecting how this script will search for files:              \n" );
      print( "                                                                      \n" );
      print( "   -descend x                                                         \n" );
      print( "   -d                                                                 \n" );
      print( "        How many subdirs to descend when searching for src files.     \n" );
      print( "        Pass 1 to descend down to one subdir level.                   \n" );
      print( "        Pass 0 to not descend at all.                                 \n" );
      print( "        (If -d is not passed, default is $descend subdirs.)           \n" );
      print( "                                                                      \n" );
      print( "   -case  or  -no-case                                                \n" );
      print( "              -nc                                                     \n" );
      print( "        Whether to regard or ignore filename case, resp.              \n" );
      print( "        Default is -case (regard filename case).                      \n" );
      print( "        (on FreeBSD, -no-case only works if findutils pkg is installed)\n" );
      print( "                                                                      \n" );
      print( "   -lang  c,c++,java,py[thon],perl,forth,asm,m4                       \n" );
      print( "   -l                                                                 \n" );
      print( "        Affects which kinds of src files this script will search for. \n" );
      print( "        Multiple languages can be passed (* separate with commas).    \n" );
      print( "        Filenames of other languages can still be passed explicitly.  \n" );
      print( "                                                                      \n" );
      print( "   -langmap (see Exuberant ctags --langmap documentation)             \n" );
      print( "        Source files with non-standard file extensions can be treated \n" );
      print( "        as if they were files of a supported programming language.    \n" );
      print( "        hypersrc doesn't support as many languages as Exuberant does  \n" );
      print( "        and will default to C for unsupported ones.  Unlike ctags,    \n" );
      print( "        multiple file extensions must be separated by commas.         \n" );
      print( "                                                                      \n" );
      print( "   -ext  <.fileExtension>...                                          \n" );
      print( "   -e                                                                 \n" );
      print( "        If -lang/-langmap do not support a particular file extension, \n" );
      print( "        then use -ext to specify it.  Eg: \'-ext .txt\'               \n" );
      print( "        Multiple extensions can be passed (* separate with commas).   \n" );
      print( "                                                                      \n" );
      print( "   -include <string>...                                               \n" );
      print( "   -i                                                                 \n" );
      print( "        Include any files whose pathnames contain <string>.           \n" );
      print( "        Multiple strings can be passed (* separate with commas).      \n" );
      print( "        To include all files, pass \\* (escape star).                 \n" );
      print( "                                                                      \n" );
      print( "   -exclude <string>...                                               \n" );
      print( "   -x                                                                 \n" );
      print( "        Exclude files whose pathnames contain <string>.               \n" );
      print( "        Multiple strings can be passed (* separate with commas).      \n" );
      print( "                                                                      \n" );
      print( "   -cd <dir>                                                          \n" );
      print( "        Change CWD used by this script.                               \n" );
      print( "        Can be used to browse a subdir without showing long pathnames.\n" );
      print( "        Should be passed prior to srcs/dirs.                          \n" );
      print( "                                                                      \n" );
      print( "   * if a comma-separated arg contains any spaces it must be quoted   \n" );
      print( "                                                                      \n" );
      print( "Other options:                                                        \n" );
      print( "                                                                      \n" );
      print( "   -ctags                                                             \n" );
      print( "        Full pathname to Exuberant ctags.                             \n" );
      print( "                                                                      \n" );
      print( "   -q                                                                 \n" );
      print( "        Script runs quietly.                                          \n" );
      print( "                                                                      \n" );
      print( "   -proto                                                             \n" );
      print( "        Tag function prototypes (disabled by default).                \n" );
      print( "                                                                      \n" );
      print( "   -class-qual                                                        \n" );
      print( "        Fully qualify C++ class members.                              \n" );
      print( "        (eg show 'class::member' in tag name)                         \n" );
      print( "                                                                      \n" );
      print( "hypersrc-specific options:                                            \n" );
      print( "                                                                      \n" );
      print( "  Options not handled by Hypersrc.pl will be passed thru to hypersrc. \n" );
      print( "                                                                      \n" );
      print( "Examples (that descend down to a few subdirs):                        \n" );
      print( "                                                                      \n" );
      print( "  Hypersrc.pl                    (defaults to C src files: .c/.h)           \n" );
      print( "  Hypersrc.pl -lang c,c++        (browse C and C++ src files)               \n" );
      print( "  Hypersrc.pl -lang c c++        (WRONG, must be one comma-separated word)  \n" );
      print( "  Hypersrc.pl -lang perl         (browse only Perl src files)               \n" );
      print( "  Hypersrc.pl -langmap=c:+.d *.d (treat .d files as C src files)            \n" );
      print( "  Hypersrc.pl -langmap=c:.d,.e   (treat .d/.e files as C src files)         \n" );
      print( "  Hypersrc.pl -ext .cc           (browse only C++ src files ending with .cc)\n" );
      print( "  Hypersrc.pl myprog/src         (browse C src files in a subdir)           \n" );
      print( "  Hypersrc.pl -x obj/,bak/       (exclude files in these subdirs)           \n" );
      print( "                                                                      \n" );
      print( "Examples (which don't descend into subdirs)                           \n" );
      print( "                                                                      \n" );
      print( "  Hypersrc.pl *.f77        (browse Fortran src files)                 \n" );
      print( "                                                                      \n" );
      print( "Jim Brooks                                                            \n" );
      print( "Updates available at: http://www.jimbrooks.org/hypersrc/              \n" );
      print( "\n" );
      exit 0;
   }

   if ( $_ eq "-descend"  ||  $_ eq "-d"  ||  $_ eq "-maxdepth" )
   {
      MaybePrintNewline();

      $arg_descend = $args[$argIdx+1];

      # Check the number passed after -descend.
      #
      if ( $arg_descend !~ /[0-9]/ )
      { ErrorMsg( "## Non-number passed with -descend.  Quitting. \n" ); exit 1; }

      # Passing 0, which is acceptable, means to gather src files in CWD only.
      #
      if ( $arg_descend > 0 )
      { Msg( "Will descend no more than $arg_descend subdir levels. \n" ); }
      else
      { Msg( "Won't descend down any subdirs. \n" ); }

      # Assign $descend with 1 added for 'find -maxdepth'.
      #
      $descend = $arg_descend + 1;

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-ctags" )
   {
      # Full pathname to Exuberant ctags.
      #
      $ctagsArgPassed = 1;
      $ctags = $args[$argIdx+1];
      if ( substr( $ctags, 0, 1 ) ne "/" )
      { ErrorMsg( "## Full pathname is required with -ctags.  Quitting. \n" ); exit 1; }

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-class-qual" )
   {
      # This arg will be passed to, and handled by, ctags.pl.
      #
      $ctags_pl_args = $ctags_pl_args . " -class-qual ";

      @argsHypersrc = ( @argsHypersrc, "-class-qual" );

      next;
   }

   if ( $_ eq "-proto" )
   {
      # This arg will be passed to, and handled by, ctags.pl.
      #
      $ctags_pl_args = $ctags_pl_args . " -proto ";
      next;
   }

   # --langmap (or -langmap)
   if ( $_ =~ /langmap=/ )
   {
      # hypersrc uses commas to separate but ctags doesn't:
      # hypersrc: -langmap=c:+.d,+.e
      # ctags   : -langmap=c:+.d+.e
      # Note: ctags.pl will remove the commas.

      # Quirk: Hypersrc.pl -langmap=c:.d,+.e will seem to fail
      # if there is a .d file but no .e nor .c files (ctags will exit).
      # Solutions are -langmap=c:.d or -langmap=c:.d,.e

      my $arg = $_;
      $ctags_pl_args .= " $arg ";
      @argsHypersrc   = ( @argsHypersrc, $arg );

      my $lang = $arg;
      $lang =~ /=.*:/;
      $lang = $&;
      $lang = substr($lang,1); chop($lang);

      # Parse each file extension embedded in -langmap.
      # Scan past colon eg "--langmap=c:+.d"
      my $exts = substr( $arg, index( $arg, ":" ) + 1 );
      foreach ( split /,/,$exts )
      {
         # Discard "+" in case of --langmap=c:+.cc,+.cxx
         if ( substr( $_, 0, 1 ) eq '+' ) { $_ = substr( $_, 1 ); }
         # Prepend "." to ext if omitted.
         if ( substr( $_, 0, 1 ) ne '.' ) { $_ = "." . $_; }
         @ext = ( @ext, $_ );
         MaybePrintNewline();
         Msg( "Will treat *${_} files as $lang \n" );
      }

      next;
   }

   if ( $_ eq "-ext"  ||  $_ eq "-e" )
   {
      @argsHypersrc = ( @argsHypersrc, "-accept-all-tags" );

      # For each comma-separated item in the following arg.
      #
      foreach ( split /,/,$args[$argIdx+1] )
      {
         if ( substr( $_, 0, 1 ) ne '.' ) { $_ = "." . $_; } # prepend "." to ext if omitted
         @ext = ( @ext, $_ );
         MaybePrintNewline();
         Msg( "Will browse files with extension \'$_\'\n" );
      }
      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-exclude"  ||  $_ eq "-x" )
   {
      # For each comma-separated item in the following arg.
      #
      foreach ( split /,/,$args[$argIdx+1] )
      {
         @excludeList = ( @excludeList, $_ );
         MaybePrintNewline();
         Msg( "Will exclude files with pathnames matching '$_' \n" );
      }
      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-include"  ||  $_ eq "-i" )
   {
      # For each comma-separated item in the following arg.
      #
      foreach ( split /,/,$args[$argIdx+1] )
      {
         @includeList = ( @includeList, $_ );
         MaybePrintNewline();
         Msg( "Will include files with pathnames matching '$_' \n" );
      }
      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  ||  $_ eq "-l" )
   {
      if ( ParseArgLang() )
      {
         ErrorMsg( "## Arg passed with -lang wasn't understood.  Quitting. \n" );
         exit 1;
      }
      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-cd"  ||  $_ eq "-cwd"  ||  $_ eq "-chdir" )
   {
      # The relation of any preceding srcs/dirs
      # will be altered by -cd so warn user.
      #
      if ( scalar(@dirs)  ||  $srcString ne "" )
      {
         ErrorMsg( "## -cd should precede any srcs/dirs. \n" );
         exit 1;
      }

      $arg_cd = $args[$argIdx+1];
      if ( !chdir( $arg_cd ) )
      {
         ErrorMsg( "## Could not chdir to $arg_cd \n" );
         exit 1;
      }

      Msg( "Will chdir to $arg_cd \n" );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-title" )
   {
      # The user has specified a window title so don't build one automatically.
      #
      $title = $args[$argIdx+1];
      $ignoreNextArg = 1;
      next;
   }


   if ( $_ eq "-gdb" )
   {
      $gdb = 1;
      next;
   }

   if ( $_ eq "-valgrind" )
   {
      $valgrind = 1;
      next;
   }

   # --DEPRECATED--
   #
   if ( $_ eq "-srcs"  ||  $_ eq "-src" )
   {
      next;
   }

   # --DEPRECATED--
   #
   if ( $_ eq "-dirs"  ||  $_ eq "-dir" )
   {
      next;
   }

   # This arg wasn't recognized.
   # Is it a file?
   #
   if ( -f $_ )
   {
      # For readability, remove "./" prefix (if "find" was used).
      #
      $fname = $_;
      if ( substr( $fname, 0, 2 ) eq "./" )
      { $fname = substr( $fname, 2 ); } 

      # Add this arg to the list of src files.
      # Go to next arg.
      #
      $srcString = $srcString . $fname . "\n";
      @srcs = ( @srcs, $fname );
      $argIdxPrevImplSrc = $argIdx;

      # The -src option is implied (-src was deprecated).
      # -src inhibits the default behavior finding C files.
      #
      $srcsOption = 1;

      next;
   }

   # This arg wasn't recognized.
   # Is it a directory?
   #
   if ( -d $_ )
   {
arg_dir:
      # Add this arg to the list of dirs.
      # Go to next arg.
      #
      MaybePrintNewline();
      @dirs = ( @dirs, "$_" );
      $dir = $_;
      if ( substr( $dir, length($dir)-1, 1 ) ne "/" ) { $dir = $dir . "/"; }
      Msg( "Will descend dir: $dir \n" );
      next;
   }

   # Is it a symlink to a dir?
   # (Perl doesn't seem to support the -L test).
   #
   $dir = readlink $_;
   if ( defined($dir)  &&  -d $dir ) { goto arg_dir; }

   # A file-glob can reach this point unexpanded if no files exist that match it.
   #
   if ( substr($_, 0, 2) eq "*."  ||  substr($_, 0, 1) eq "*" )
   {
      MaybePrintNewline();
      print "(no files match '$_') \n";
      next;
   }

   if ( $_ eq "-knr" || $_ eq "-oldc" )
   {
      Msg( "Will also parse K&R style C functions. \n" );

      @argsHypersrc = ( @argsHypersrc, "-knr" );

      next;
   }

   # -version ?
   #
   if ( $_ eq "-version" || $_ eq "--version")
   {
      @argsHypersrc = ( @argsHypersrc, $_ );
      goto run_hypersrc_now;
   }

   # This arg is not understood by Hypersrc.pl.
   # Add it to the arg list that is assumed to be for hypersrc.
   #
   @argsHypersrc = ( @argsHypersrc, $_ );
}

# ------------------------------------------------------------------------------

# Show filenames that were passed.
#
if ( $srcsOption )
{
   Msg( "Src files to browse: \n" );
   foreach (@srcs)
   {
      Msg( "$_ " );
   }
   Msg( "\n" );
}

MaybePrintNewline(1);

# Check that the paths are correct.
#
CheckPaths();

# Default to CWD if no files/dirs were passed.
#
if ( ! scalar(@dirs)  &&  ! $srcsOption )
{ @dirs = ( "." ); }

# Ensure that no file extension is duplicated.
# Output will be in @ext.
#
FilterDupFileExt();

# If no file extensions were specified and there is a dir list,
# then default to C src files.
#
if ( ! scalar(@ext)  &&  scalar(@dirs) )
{
   Msg( "Defaulting to C src files.\n" );
   @ext = ( ".c", ".h" );
}

# Show what file extensions will be browsed.
#
if ( scalar(@ext) ) { Msg( "Src file extensions to browse:\n@ext\n" ); }

# Build a list of src files based on dir list.
# Removing the leading "./" that is prepended by "find".
# Exclude "RCS/".
#
if ( scalar(@dirs) )
{
   # Invoke "find" to print each filename on a separate line,
   # so that ctags.pl can subsequently read filenames by line via stdin.
   #
   Msg( "Building list of src files (patience)...\n" );
   foreach $item ( @includeList )
   {
      foreach $dir (@dirs)
      {
         if ( $ignoreCase )
         { $srcString = $srcString.`$gfind $dir -follow -type f -maxdepth $descend -ipath "*$item*" 2>/dev/null `; }
         else
         { $srcString = $srcString.`$gfind $dir -follow -type f -maxdepth $descend  -path "*$item*" 2>/dev/null `; }
      }
   }
   foreach $item ( @ext )
   {
      foreach $dir (@dirs)
      {
         if ( $ignoreCase )
         { $srcString = $srcString.`$gfind $dir -follow -type f -maxdepth $descend -iname "*$item" 2>/dev/null `; }
         else
         { $srcString = $srcString.`$gfind $dir -follow -type f -maxdepth $descend  -name "*$item" 2>/dev/null `; }
      }
   }
   $srcString =~ s/^\.\///;         # (first)    remove "./" but not "../"
   $srcString =~ s/\n\.\//\n/g;     # (the rest) remove "./" but not "../"
#  $srcString =~ s/\bRCS.*\b//;
   $srcString =~ s/.*RCS.*\n//g;
}

# Ensure the list of src files is not empty.
#
if ( $srcString eq "" )
{
   ErrorMsg( "## No src files were found nor specified.  Quitting. \n" );
   ErrorMsg( "## Perhaps try passing -no-case to find MSDOG src files. \n" );
   exit 1;
}

# Exclude files.
#
$size = @excludeList;
if ( $size > 0 ) { ExcludeFiles(); }

# Remove duplicate files.
#
RemoveDuplicateFiles();

# Title the main window based on list of files/dirs.
#
unless ( $title ne "" ) # unless user passed -title
{
   if ( scalar(@dirs) )
   {
      BuildTitleFromList( "dirs" );
      if ( $srcsOption  &&  length($title)+2 < $titleLenMax )
      { $title = $title . ", "; }
   }
   if ( $srcsOption )
   {
      BuildTitleFromList( "srcs" );
   }
}

# Choose vim over vi if vim exists.
#
$_ = `which vim`;
chomp;  # sometimes `which` spews a newline
if ( "$_" ne "" )
{
   @argsHypersrc = ( @argsHypersrc, "-vim-exists" );
}

# Choose devhelp if exists.
#
$_ = `which devhelp`;
chomp;
if ( "$_" ne "" )
{
	@argsHypersrc = ( @argsHypersrc, "-devhelp-exists" );
}

####################################
# Debug: dump ctags output to a file
####################################
if ( 0 )
{
   Msg( "DEBUG: dumping tags to /tmp/tags.tmp \n" );
   open( PIPE, "| $ctags_pl  -ctags-path $ctags  -stdin  $ctags_pl_args > /tmp/tags.tmp" );
   print PIPE "$srcString";
   close( PIPE );
   exit 0;
}
#####################################


###############################
# Debug: Run hypersrc under gdb
###############################
if ( $gdb )
{
   # Create gdb command file (for hypersrc args).
   #
   $cmdFile = "/tmp/hypersrc_gdb_${PID}.tmp";
   open( CMD_FILE, ">$cmdFile" );
   print CMD_FILE "run -stdin $argsHypersrcCustom @argsHypersrc -title 'hypersrc ($title)' \n";
   print CMD_FILE "q \n";
   close( CMD_FILE );

   Msg( "Piping ctags into hypersrc (please wait)... \n" );
   open( PIPE, "| $ctags_pl  -ctags-path $ctags  -stdin  $ctags_pl_args  |  gdb -x $cmdFile $hypersrc " );
   print PIPE "$srcString";
   close( PIPE );

   system "rm -f $cmdFile";

   exit 0;
}
###############################


####################################
# Debug: Run hypersrc under valgrind
####################################
if ( $valgrind )
{
   # Dump tags to a file (can't pipe to valgrind and then to hypersc).
   Msg( "DEBUG: dumping tags to /tmp/tags.tmp \n" );
   open( PIPE, "| $ctags_pl  -ctags-path $ctags  -stdin  $ctags_pl_args > /tmp/tags.tmp" );
   print PIPE "$srcString";
   close( PIPE );

   # Determine valgrind args according to its version.
   $valgrindHelp = `valgrind --help 2>&1`;
   if ( $valgrindHelp =~ /tool=/ )
   {
      $valgrindArgs = " --leak-check=yes --tool=memcheck ";
   }
   else
   {
      $valgrindArgs = " --leak-check=yes ";
   }

   # Run hypersrc under valgrind.
   Msg( "DEBUG: running under valgrind ($valgrindArgs)... \n" );
   system( "valgrind $valgrindArgs $hypersrc -ctags-x /tmp/tags.tmp $argsHypersrcCustom @argsHypersrc -title 'hypersrc ($title)'" );
   exit 0;
}
###############################


# Start the pipeline.
# Begin by piping the list of filenames to ctags.pl.
# (Piping is necessary because list might be too long to be passed via cmd-line).
#
Msg( "Piping ctags into hypersrc (please wait)... \n" );
run_hypersrc_now:
open( PIPE, "| $ctags_pl  -ctags-path $ctags  -stdin  $ctags_pl_args  |  $hypersrc -stdin $argsHypersrcCustom @argsHypersrc -title 'hypersrc ($title)'" );
print PIPE "$srcString";
close( PIPE );

# Done.
#
exit 0;

# =============================================================================
# subroutines
# =============================================================================

sub Msg
{
   # Only print a message if $verbose.
   #
   if ( $verbose ) { print "$_[0]"; }
}

sub ErrorMsg
{
   print STDERR "$_[0]";
}

sub IsHypersrcExecutable
{
   # Return true if $hypersrc points to an executable binary.
   # Ignore hypersrc dir (dirs are also executable).
   #
   stat( "$hypersrc" );
   if ( -x _  &&  ! -d _ ) { return 1; }
   return 0;
}

sub TestInvokingHypersrc
{
   # Return true if hypersrc can be invoked.
   #
   $_ = `$hypersrc -h`;
   return defined($_)  &&  ($_ ne "");
}

# Remove duplicate file extensions out of @ext.
#
sub FilterDupFileExt
{
   my %seen = ( );
   my @tmp  = @ext;
   my $item;

   @ext  = ( );

   # Rebuild @ext without duplicate file extensions.
   #
   foreach $item (@tmp)
   {
      unless ($seen{$item})
      {
         # Never seen before.
         #
         $seen{$item} = 1;
         push(@ext, $item);
      }
   }
}

sub CheckPaths
{
   # Ensure $hypersrc points to an executable.
   # If not, try to correct $hypersrc.
   #
   if ( ! IsHypersrcExecutable() )
   {
#      ErrorMsg( "## Configured path to hypersrc is wrong, defaulting to PATH. \n" );

      # Remember original paths.
      #
      $hypersrc_orig = $hypersrc;
      $ctags_pl_orig = $ctags_pl;

      # Try to locate hypersrc using PATH.
      #
      $hypersrc  =  "hypersrc";		# <-- extra spaces to fool Makefile install

      if ( ! IsHypersrcExecutable() )
      {
         # Perhaps Hypersrc.pl was invoked after "make install" was done?
         #
         $hypersrc = $Hypersrc_pl;
         $hypersrc =~ s/${Hypersrc_pl}/hypersrc/;

         $ctags_pl = $Hypersrc_pl;
         $ctags_pl =~ s/${Hypersrc_pl}/ctags.pl/;
      }
      if ( ! IsHypersrcExecutable() )
      {
         # Perhaps Hypersrc.pl was invoked without "make install"?
         #
         $hypersrc = $Hypersrc_pl;
         $hypersrc =~ s/${Hypersrc_pl}/out\/hypersrc/;

         $ctags_pl = $Hypersrc_pl;
         $ctags_pl =~ s/${Hypersrc_pl}/ctags.pl/;
      }
      if ( ! IsHypersrcExecutable() )
      {
         # Perhaps Hypersrc.pl is a symlink?
         #
         $hypersrc = readlink "$PROGRAM_NAME";
         chomp $hypersrc;
         $hypersrc =~ s/${Hypersrc_pl}/out\/hypersrc/;

         $ctags_pl = readlink "$PROGRAM_NAME";
         chomp $ctags_pl;
         $ctags_pl =~ s/${Hypersrc_pl}/ctags.pl/;
      }
      if ( ! IsHypersrcExecutable() )
      {
         # Ugghhh, the programs appear to not be executable and/or outside PATH.
         # Charge forward with invocation test, in case this Perl code here is mistaken.
         #
         #ErrorMsg( "## This script\'s paths seem misconfigured, proceeding anyway... ##\n" );
         $hypersrc = $hypersrc_orig;
         $ctags_pl = $ctags_pl_orig;
      }
   }

   # Ensure hypersrc can be invoked.
   #
   if ( ! TestInvokingHypersrc() )
   {
      ErrorMsg( "## Failed to execute 'hypersrc'. \n" );
      ErrorMsg( "## Try 'make install', or copy hypersrc somewhere into PATH, \n" );
      ErrorMsg( "## or configure this Perl script (Hypersrc.pl). \n" );
      exit 1;
   }

   # Ensure there is a recent version of Exuberant ctags.
   #
   $_ = `$ctags --version 2>/dev/null | grep Exuberant`;
   if (    $ctagsArgPassed
        && ("" eq $_  ||  ! defined($_)) )
   {
      ErrorMsg( "## -ctags passed but $ctags wasn't found. \n" );
      exit 1;
   }
   if ( "" eq $_  ||  ! defined($_) )
   {
      # Perhaps this is not Red Hat 6.0 but Exuberant ctags is at /usr/local/bin?
      #
      $ctags ="/usr/local/bin/ctags";
   }
   $_ = `$ctags --version 2>/dev/null | grep Exuberant`;
   if ( "" eq $_  ||  ! defined($_) )
   {
      # Try PATH.
      #
      $ctags ="ctags";
   }
   $_ = `$ctags --version 2>/dev/null | grep Exuberant`;
   if ( "" eq $_  ||  ! defined($_) )
   {
      # Try OS-specific filenames for Exuberant ctags.
      #
      $uname = `uname`;
      if ( $uname =~ "FreeBSD" )
      { $ctags ="exctags"; } # FreeBSD 4.10
      else
      { $ctags ="exuberant-ctags"; } # Mandrake 8.1
   }
   $_ = `$ctags --version 2>/dev/null | grep Exuberant`;
   if ( "" eq $_  ||  ! defined($_) )
   {
      ErrorMsg( "## Couldn't find a recent version of Exuberant ctags.\n" );
      ErrorMsg( "## Does GNU ctags precede it in PATH? \n" );
      ErrorMsg( "## Try passing -ctags [pathname] \n" );
#     ErrorMsg( "## Exuberant ctags is available at http://fly.hiwaay.net/~darren/ctags \n" );
      ErrorMsg( "## Exuberant ctags is available at: \n" );
      ErrorMsg( "## http://ctags.sourceforge.net or ftp.jimbrooks.org/hypersrc/exuberant_ctags/ \n" );
      exit 1;
   }
}

# Append to title string from src or dir list.
# Parms: $1 = "dirs" or "srcs"
#        $title (this subroutine appends to this string)
#
sub BuildTitleFromList
{
   my $dirs_or_srcs = $_[0];
   my @list;
   my $item;

   # Use either the file or dir list.
   #
   if    ( "$dirs_or_srcs" eq "dirs" )
   {
      @list = @dirs;

      # If the only dir is "." (no dirs were passed by user)
      # then determine the name of CWD.
      #
      if ( scalar(@list) == 1  &&  $list[0] eq "." )
      {
         if ( $shortWindowTitleFlag )
            { $list[0] = basename( cwd() ); }
         else
            { $list[0] = cwd(); }
      }
   }
   elsif ( "$dirs_or_srcs" eq "srcs" )
   {
      @list = @srcs;
   }
   else
   { die; }

   # Accumulate a limited amount of items into the title string.
   #
   for ( 0 .. $#list )
   {
      if ( length($title) > $titleLenMax ) { last; }

      if ( $shortWindowTitleFlag )
      {
         # basename() will be confused by a superfluous trailing "/".
         #
         $item = $list[$_];
         if ( substr( $item, length($item)-1, 1 ) eq "/" )
         { chop $item; }

         if ( $_ > 0 ) { $title = $title . ", "; }
         $title = $title . basename( $item );

         if ( "$dirs_or_srcs" eq "dirs" )
         { $title = $title . "/"; }
      }
      else
      {
         $title = "$dirs_or_srcs: $list[0], [...]";
         last;
      }
   }

   # Add ellipsis if there were too many items.
   #
   if ( length($title) > $titleLenMax ) { $title = $title . ", [...]"; }
}

# Print a newline depending on how the previous arg was printed.
# Pass nothing if within the arg loop, pass 1 after leaving the loop.
#
sub MaybePrintNewline
{
   # (no longer ever need to print a newline)
}

# Exclude src files from $srcString which match any regex in @excludeList.
#
sub ExcludeFiles
{
   # Derive a list from the lines in $srcString.
   #
   my @srcStringList = split /\n/,"$srcString";

   $srcString = "";

   # Rebuild $srcString without excluded files.
   #
   foreach $src (@srcStringList)
   {
      $excludeFlag = 0;
      foreach $excludePattern (@excludeList)
      {
         if ( $src =~ ".*$excludePattern.*" )
         {
            $excludeFlag = 1;
            last;
         }
      }
      if ( ! $excludeFlag )
      {
         $srcString = $srcString . $src . "\n";
      }
   }
}

# Remove any duplicate files in $srcString.
#
sub RemoveDuplicateFiles
{
   # Derive a list from the lines in $srcString.
   #
   my @srcStringList = split /\n/,"$srcString";

   $srcString = "";

   # Rebuild $srcString without duplicates using a hash.
   #
   %seen = ();
   foreach $src ( @srcStringList )
   {
      $srcString = $srcString . $src . "\n" unless $seen{$src}++;
   }
}

# Parse the arg -lang
# Returns 0 if no errors.
#
sub ParseArgLang
{
   # For each comma-separated item in the following arg.
   #
   foreach ( split /,/,$args[$argIdx+1] )
   {
      if ( $_ eq "c" )
      {
         MaybePrintNewline();
         Msg( "Will browse C language src files.\n" );
         @ext = ( @ext, ".c" );		# -- don't add .C/.H (remember there is -no-case) --
         @ext = ( @ext, ".h" );

         next;
      }

      if ( $_ eq "c++" )
      {
         MaybePrintNewline();
         Msg( "Will browse C++ language src files.\n" );
         @ext = ( @ext, ".cc"  );	# -- don't add .CC (remember there is -no-case) --
         @ext = ( @ext, ".cpp" );	# a dumb C++ ext
         @ext = ( @ext, ".cxx" );
         @ext = ( @ext, ".c++" );
         if ( ! $ignoreCase )
       { @ext = ( @ext, ".C"   );	# another dumb one
         @ext = ( @ext, ".H"   ); }	# another dumb one
         @ext = ( @ext, ".h"   );	# overlap with C
         @ext = ( @ext, ".hh"  );
         @ext = ( @ext, ".hpp" );
         @ext = ( @ext, ".hxx" );
         @ext = ( @ext, ".h++" );
         @ext = ( @ext, ".inl" );	# inline functions (specific to C++ ?)

         @argsHypersrc = ( @argsHypersrc, "-cplusplus" );

         next;
      }

      if ( $_ eq "java" )
      {
         MaybePrintNewline();
         Msg( "Will browse Java src files.\n" );
         @ext = ( @ext, ".java" );
         @ext = ( @ext, ".jav" );
         @ext = ( @ext, ".j" );

         @argsHypersrc = ( @argsHypersrc, "-java" );

         next;
      }

      if ( $_ eq "python" || $_ eq "py" )
      {
         MaybePrintNewline();
         Msg( "Will browse Python language src files.\n" );
         @ext = ( @ext, ".py" );		# -- don't add .PY (remember there is -no-case) --

         next;
      }

      if ( $_ eq "asm" )
      {
         MaybePrintNewline();
         Msg( "Will browse assembly language src files.\n" );
         @ext = ( @ext, ".s" );
         if ( ! $ignoreCase )
       { @ext = ( @ext, ".S" );  }	# asm file that needs cpp preprocessing
         @ext = ( @ext, ".sm4" );	# asm file that needs M4 preprocesing
         @ext = ( @ext, ".asm" );	# -- don't add .ASM (remember there is -no-case) --
         @ext = ( @ext, ".inc" );

         next;
      }

      if ( $_ eq "perl" )
      {
         MaybePrintNewline();
         Msg( "Will browse Perl script src files.\n" );
         @ext = ( @ext, ".pl" );	# -- don't add .PL (remember there is -no-case) --
         @ext = ( @ext, ".pm" );	# Perl module
         @ext = ( @ext, ".ph" );	# Perl header

         next;
      }

      if ( $_ eq "m4" )
      {
         MaybePrintNewline();
         Msg( "Will browse M4 macro src files.\n" );
         @ext = ( @ext, ".m4" );	# -- don't add .M4 (remember there is -no-case) --

         next;
      }

      if ( $_ eq "forth" )
      {
         MaybePrintNewline();
         Msg( "Will browse FORTH src files.\n" );
         @ext = ( @ext, ".4th" );	# -- don't add .4TH (remember there is -no-case) --
         @ext = ( @ext, ".fth" );
         @ext = ( @ext, ".seq" );
         @ext = ( @ext, ".fs"  );   # Gforth
#        @ext = ( @ext, ".fb"  );   # Gforth (hypersrc can't show FORTH block files properly)

         next;
      }

      # None of the above.
      #
      return -1;
   }

   # Success.
   #
   return 0;
}
